home *** CD-ROM | disk | FTP | other *** search
/ BCI NET / BCI NET Dec 94.iso / archives / programming / source / f2c3.2src.lha / f2c-for-SASC651 / src / sysdep.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-10-15  |  12.3 KB  |  542 lines
  1. /****************************************************************
  2. Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore.
  3.  
  4. Permission to use, copy, modify, and distribute this software
  5. and its documentation for any purpose and without fee is hereby
  6. granted, provided that the above copyright notice appear in all
  7. copies and that both that the copyright notice and this
  8. permission notice and warranty disclaimer appear in supporting
  9. documentation, and that the names of AT&T Bell Laboratories or
  10. Bellcore or any of their entities not be used in advertising or
  11. publicity pertaining to distribution of the software without
  12. specific, written prior permission.
  13.  
  14. AT&T and Bellcore disclaim all warranties with regard to this
  15. software, including all implied warranties of merchantability
  16. and fitness.  In no event shall AT&T or Bellcore be liable for
  17. any special, indirect or consequential damages or any damages
  18. whatsoever resulting from loss of use, data or profits, whether
  19. in an action of contract, negligence or other tortious action,
  20. arising out of or in connection with the use or performance of
  21. this software.
  22. ****************************************************************/
  23. #include <stdio.h>
  24. #include "defs.h"
  25. #include "usignal.h"
  26.  
  27. char binread[] = "rb", textread[] = "r";
  28. char binwrite[] = "wb", textwrite[] = "w";
  29. char *c_functions    = "c_functions";
  30. char *coutput        = "c_output";
  31. char *initfname        = "raw_data";
  32. char *initbname        = "raw_data.b";
  33. char *blkdfname        = "block_data";
  34. char *p1_file        = "p1_file";
  35. char *p1_bakfile    = "p1_file.BAK";
  36. char *sortfname        = "init_file";
  37. char *proto_fname    = "proto_file";
  38.  
  39. char link_msg[]        = "f2c.lib math=standard";
  40.  
  41. char *outbuf = "", *outbtail;
  42.  
  43. #ifndef TMPDIR
  44. #ifdef MSDOS
  45. #define TMPDIR ""
  46. #else
  47. #ifdef AMIGA
  48. #define TMPDIR "T:"
  49. #else
  50. #define TMPDIR "/tmp"
  51. #endif
  52. #endif
  53. #endif
  54.  
  55. char *tmpdir = TMPDIR;
  56. #ifndef MSDOS
  57. #ifndef KR_headers
  58. extern int getpid(void);
  59. #endif
  60. #endif
  61.  
  62.  void
  63. #ifdef KR_headers
  64. Un_link_all(cdelete)
  65.     int cdelete;
  66. #else
  67. Un_link_all(int cdelete)
  68. #endif
  69. {
  70. #ifndef KR_headers
  71.     extern int unlink(const char *);
  72. #endif
  73.     if (!debugflag) {
  74.         unlink(c_functions);
  75.         unlink(initfname);
  76.         unlink(p1_file);
  77.         unlink(sortfname);
  78.         unlink(blkdfname);
  79.         if (cdelete && coutput)
  80.             unlink(coutput);
  81.         }
  82.     }
  83.  
  84.  void
  85. set_tmp_names(Void)
  86. {
  87.     int k;
  88.     if (debugflag == 1)
  89.         return;
  90. #ifdef AMIGA
  91.     k = L_tmpnam + 1; /* gives us 5 bytes more than we need */
  92. #else
  93.     k = strlen(tmpdir) + 16;
  94. #endif
  95.     c_functions = (char *)ckalloc(7*k);
  96.     initfname = c_functions + k;
  97.     initbname = initfname + k;
  98.     blkdfname = initbname + k;
  99.     p1_file = blkdfname + k;
  100.     p1_bakfile = p1_file + k;
  101.     sortfname = p1_bakfile + k;
  102.     {
  103. #ifdef MSDOS
  104.     char buf[64], *s, *t;
  105.     if (!*tmpdir || *tmpdir == '.' && !tmpdir[1])
  106.         t = "";
  107.     else {
  108.         /* substitute \ for / to avoid confusion with a
  109.          * switch indicator in the system("sort ...")
  110.          * call in formatdata.c
  111.          */
  112.         for(s = tmpdir, t = buf; *s; s++, t++)
  113.             if ((*t = *s) == '/')
  114.                 *t = '\\';
  115.         if (t[-1] != '\\')
  116.             *t++ = '\\';
  117.         *t = 0;
  118.         t = buf;
  119.         }
  120.     sprintf(c_functions, "%sf2c_func", t);
  121.     sprintf(initfname, "%sf2c_rd", t);
  122.     sprintf(blkdfname, "%sf2c_blkd", t);
  123.     sprintf(p1_file, "%sf2c_p1f", t);
  124.     sprintf(p1_bakfile, "%sf2c_p1fb", t);
  125.     sprintf(sortfname, "%sf2c_sort", t);
  126. #else
  127. #ifdef AMIGA
  128.     c_functions = tmpnam(c_functions);
  129.     initfname   = tmpnam(initfname);
  130.     blkdfname   = tmpnam(blkdfname);
  131.     p1_file     = tmpnam(p1_file);
  132.     p1_bakfile  = tmpnam(p1_bakfile);
  133.     sortfname   = tmpnam(sortfname);
  134. #else
  135.     int pid = getpid();
  136.     sprintf(c_functions, "%s/f2c%d_func", tmpdir, pid);
  137.     sprintf(initfname, "%s/f2c%d_rd", tmpdir, pid);
  138.     sprintf(blkdfname, "%s/f2c%d_blkd", tmpdir, pid);
  139.     sprintf(p1_file, "%s/f2c%d_p1f", tmpdir, pid);
  140.     sprintf(p1_bakfile, "%s/f2c%d_p1fb", tmpdir, pid);
  141.     sprintf(sortfname, "%s/f2c%d_sort", tmpdir, pid);
  142. #endif
  143. #endif
  144.     sprintf(initbname, "%s.b", initfname);
  145.     }
  146.     if (debugflag)
  147.         fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions,
  148.             initfname, blkdfname, p1_file, p1_bakfile, sortfname);
  149.     }
  150.  
  151.  char *
  152. #ifdef KR_headers
  153. c_name(s, ft)
  154.     char *s;
  155.     int ft;
  156. #else
  157. c_name(char *s, int ft)
  158. #endif
  159. {
  160.     char *b, *s0;
  161.     int c;
  162.  
  163.     b = s0 = s;
  164.     while(c = *s++)
  165.         if (c == '/')
  166.             b = s;
  167.     if (--s < s0 + 3 || s[-2] != '.'
  168.              || ((c = *--s) != 'f' && c != 'F')) {
  169.         infname = s0;
  170.         Fatal("file name must end in .f or .F");
  171.         }
  172.     strcpy(outbtail, b);
  173.     outbtail[s-b] = ft;
  174.     b = copys(outbuf);
  175.     return b;
  176.     }
  177.  
  178.  static void
  179. #ifdef KR_headers
  180. killed(sig)
  181.     int sig;
  182. #else
  183. killed(int sig)
  184. #endif
  185. {
  186.     sig = sig;    /* shut up warning */
  187.     signal(SIGINT, SIG_IGN);
  188. #ifdef SIGQUIT
  189.     signal(SIGQUIT, SIG_IGN);
  190. #endif
  191. #ifdef SIGHUP
  192.     signal(SIGHUP, SIG_IGN);
  193. #endif
  194.     signal(SIGTERM, SIG_IGN);
  195.     Un_link_all(1);
  196.     exit(126);
  197.     }
  198.  
  199.  static void
  200. #ifdef KR_headers
  201. sig1catch(sig)
  202.     int sig;
  203. #else
  204. sig1catch(int sig)
  205. #endif
  206. {
  207.     sig = sig;    /* shut up warning */
  208.     if (signal(sig, SIG_IGN) != SIG_IGN)
  209.         signal(sig, killed);
  210.     }
  211.  
  212.  static void
  213. #ifdef KR_headers
  214. flovflo(sig)
  215.     int sig;
  216. #else
  217. flovflo(int sig)
  218. #endif
  219. {
  220.     sig = sig;    /* shut up warning */
  221.     Fatal("floating exception during constant evaluation; cannot recover");
  222.     /* vax returns a reserved operand that generates
  223.        an illegal operand fault on next instruction,
  224.        which if ignored causes an infinite loop.
  225.     */
  226.     signal(SIGFPE, flovflo);
  227. }
  228.  
  229.  void
  230. #ifdef KR_headers
  231. sigcatch(sig)
  232.     int sig;
  233. #else
  234. sigcatch(int sig)
  235. #endif
  236. {
  237.     sig = sig;    /* shut up warning */
  238.     sig1catch(SIGINT);
  239. #ifdef SIGQUIT
  240.     sig1catch(SIGQUIT);
  241. #endif
  242. #ifdef SIGHUP
  243.     sig1catch(SIGHUP);
  244. #endif
  245.     sig1catch(SIGTERM);
  246.     signal(SIGFPE, flovflo);  /* catch overflows */
  247.     }
  248.  
  249.  
  250. dofork(Void)
  251. {
  252. #ifdef MSDOS
  253.     Fatal("Only one Fortran input file allowed under MS-DOS");
  254. #else
  255. #ifdef AMIGA
  256.     Fatal("Only one Fortran input file allowed under AmigaDOS");
  257. #else
  258. #ifndef KR_headers
  259.     extern int fork(void), wait(int*);
  260. #endif
  261.     int pid, status, w;
  262.     extern int retcode;
  263.  
  264.     if (!(pid = fork()))
  265.         return 1;
  266.     if (pid == -1)
  267.         Fatal("bad fork");
  268.     while((w = wait(&status)) != pid)
  269.         if (w == -1)
  270.             Fatal("bad wait code");
  271.     retcode |= status >> 8;
  272. #endif
  273. #endif
  274.     return 0;
  275.     }
  276.  
  277. /* Initialization of tables that change with the character set... */
  278.  
  279. char escapes[Table_size];
  280.  
  281. #ifdef non_ASCII
  282. char *str_fmt[Table_size];
  283. static char *str0fmt[127] = { /*}*/
  284. #else
  285. char *str_fmt[Table_size] = {
  286. #endif
  287.  "\\000", "\\001", "\\002", "\\003", "\\004", "\\005", "\\006", "\\007",
  288.    "\\b",   "\\t",   "\\n", "\\013",   "\\f",   "\\r", "\\016", "\\017",
  289.  "\\020", "\\021", "\\022", "\\023", "\\024", "\\025", "\\026", "\\027",
  290.  "\\030", "\\031", "\\032", "\\033", "\\034", "\\035", "\\036", "\\037",
  291.      " ",     "!",  "\\\"",     "#",     "$",     "%%",    "&",     "'",
  292.      "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
  293.      "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
  294.      "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
  295.      "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
  296.      "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
  297.      "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
  298.      "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
  299.      "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
  300.      "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
  301.      "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
  302.      "x",     "y",     "z",     "{",     "|",     "}",     "~"
  303.      };
  304.  
  305. #ifdef non_ASCII
  306. char *chr_fmt[Table_size];
  307. static char *chr0fmt[127] = {    /*}*/
  308. #else
  309. char *chr_fmt[Table_size] = {
  310. #endif
  311.    "\\0",   "\\1",   "\\2",   "\\3",   "\\4",   "\\5",   "\\6",   "\\7",
  312.    "\\b",   "\\t",   "\\n",  "\\13",   "\\f",   "\\r",  "\\16",  "\\17",
  313.   "\\20",  "\\21",  "\\22",  "\\23",  "\\24",  "\\25",  "\\26",  "\\27",
  314.   "\\30",  "\\31",  "\\32",  "\\33",  "\\34",  "\\35",  "\\36",  "\\37",
  315.      " ",     "!",    "\"",     "#",     "$",     "%%",    "&",   "\\'",
  316.      "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
  317.      "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
  318.      "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
  319.      "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
  320.      "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
  321.      "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
  322.      "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
  323.      "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
  324.      "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
  325.      "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
  326.      "x",     "y",     "z",     "{",     "|",     "}",     "~"
  327.      };
  328.  
  329.  void
  330. fmt_init(Void)
  331. {
  332.     static char *str1fmt[6] =
  333.         { "\\b", "\\t", "\\n", "\\f", "\\r", "\\%03o" };
  334.     register int i, j;
  335.     register char *s;
  336.  
  337.     /* str_fmt */
  338.  
  339. #ifdef non_ASCII
  340.     i = 0;
  341. #else
  342.     i = 127;
  343. #endif
  344.     for(; i < Table_size; i++)
  345.         str_fmt[i] = "\\%03o";
  346. #ifdef non_ASCII
  347.     for(i = 32; i < 127; i++) {
  348.         s = str0fmt[i];
  349.         str_fmt[*(unsigned char *)s] = s;
  350.         }
  351.     str_fmt['"'] = "\\\"";
  352. #else
  353.     if (Ansi == 1)
  354.         str_fmt[7] = chr_fmt[7] = "\\a";
  355. #endif
  356.  
  357.     /* chr_fmt */
  358.  
  359. #ifdef non_ASCII
  360.     for(i = 0; i < 32; i++)
  361.         chr_fmt[i] = chr0fmt[i];
  362. #else
  363.     i = 127;
  364. #endif
  365.     for(; i < Table_size; i++)
  366.         chr_fmt[i] = "\\%o";
  367. #ifdef non_ASCII
  368.     for(i = 32; i < 127; i++) {
  369.         s = chr0fmt[i];
  370.         j = *(unsigned char *)s;
  371.         if (j == '\\')
  372.             j = *(unsigned char *)(s+1);
  373.         chr_fmt[j] = s;
  374.         }
  375. #endif
  376.  
  377.     /* escapes (used in lex.c) */
  378.  
  379.     for(i = 0; i < Table_size; i++)
  380.         escapes[i] = i;
  381.     for(s = "btnfr0", i = 0; i < 6; i++)
  382.         escapes[*(unsigned char *)s++] = "\b\t\n\f\r"[i];
  383.     /* finish str_fmt and chr_fmt */
  384.  
  385.     if (Ansi)
  386.         str1fmt[5] = "\\v";
  387.     if ('\v' == 'v') { /* ancient C compiler */
  388.         str1fmt[5] = "v";
  389. #ifndef non_ASCII
  390.         escapes['v'] = 11;
  391. #endif
  392.         }
  393.     else
  394.         escapes['v'] = '\v';
  395.     for(s = "\b\t\n\f\r\v", i = 0; j = *(unsigned char *)s++;)
  396.         str_fmt[j] = chr_fmt[j] = str1fmt[i++];
  397.     /* '\v' = 11 for both EBCDIC and ASCII... */
  398.     chr_fmt[11] = Ansi ? "\\v" : "\\13";
  399.     }
  400.  
  401.  void
  402. outbuf_adjust(Void)
  403. {
  404.     int n, n1;
  405.     char *s;
  406.  
  407.     n = n1 = strlen(outbuf);
  408.     if (*outbuf && outbuf[n-1] != '/')
  409.         n1++;
  410.     s = Alloc(n+64);
  411.     outbtail = s + n1;
  412.     strcpy(s, outbuf);
  413.     if (n != n1)
  414.         strcpy(s+n, "/");
  415.     outbuf = s;
  416.     }
  417.  
  418.  
  419. /* Unless SYSTEM_SORT is defined, the following gives a simple
  420.  * in-core version of dsort().  On Fortran source with huge DATA
  421.  * statements, the in-core version may exhaust the available memory,
  422.  * in which case you might either recompile this source file with
  423.  * SYSTEM_SORT defined (if that's reasonable on your system), or
  424.  * replace the dsort below with a more elaborate version that
  425.  * does a merging sort with the help of auxiliary files.
  426.  */
  427.  
  428. #ifdef SYSTEM_SORT
  429.  
  430.  int
  431. #ifdef KR_headers
  432. dsort(from, to)
  433.     char *from;
  434.     char *to;
  435. #else
  436. dsort(char *from, char *to)
  437. #endif
  438. {
  439.     char buf[200];
  440.     sprintf(buf, "sort <%s >%s", from, to);
  441.     return system(buf) >> 8;
  442.     }
  443. #else
  444.  
  445.  static int
  446. #ifdef KR_headers
  447.  compare(a,b)
  448.   char *a, *b;
  449. #else
  450.  compare(const void *a, const void *b)
  451. #endif
  452. { return strcmp(*(char **)a, *(char **)b); }
  453.  
  454. #ifdef KR_headers
  455. dsort(from, to)
  456.     char *from;
  457.     char *to;
  458. #else
  459. dsort(char *from, char *to)
  460. #endif
  461. {
  462.     struct Memb {
  463.         struct Memb *next;
  464.         int n;
  465.         char buf[32000];
  466.         };
  467.     typedef struct Memb memb;
  468.     memb *mb, *mb1;
  469.     register char *x, *x0, *xe;
  470.     register int c, n;
  471.     FILE *f;
  472.     char **z, **z0;
  473.     int nn = 0;
  474.  
  475.     f = opf(from, textread);
  476.     mb = (memb *)Alloc(sizeof(memb));
  477.     mb->next = 0;
  478.     x0 = x = mb->buf;
  479.     xe = x + sizeof(mb->buf);
  480.     n = 0;
  481.     for(;;) {
  482.         c = getc(f);
  483.         if (x >= xe && (c != EOF || x != x0)) {
  484.             if (!n)
  485.                 return 126;
  486.             nn += n;
  487.             mb->n = n;
  488.             mb1 = (memb *)Alloc(sizeof(memb));
  489.             mb1->next = mb;
  490.             mb = mb1;
  491.             memcpy(mb->buf, x0, n = x-x0);
  492.             x0 = mb->buf;
  493.             x = x0 + n;
  494.             xe = x0 + sizeof(mb->buf);
  495.             n = 0;
  496.             }
  497.         if (c == EOF)
  498.             break;
  499.         if (c == '\n') {
  500.             ++n;
  501.             *x++ = 0;
  502.             x0 = x;
  503.             }
  504.         else
  505.             *x++ = c;
  506.         }
  507.     clf(&f, from, 1);
  508.     f = opf(to, textwrite);
  509.     if (x > x0) { /* shouldn't happen */
  510.         *x = 0;
  511.         ++n;
  512.         }
  513.     mb->n = n;
  514.     nn += n;
  515.     if (!nn) /* shouldn't happen */
  516.         goto done;
  517.     z = z0 = (char **)Alloc(nn*sizeof(char *));
  518.     for(mb1 = mb; mb1; mb1 = mb1->next) {
  519.         x = mb1->buf;
  520.         n = mb1->n;
  521.         for(;;) {
  522.             *z++ = x;
  523.             if (--n <= 0)
  524.                 break;
  525.             while(*x++);
  526.             }
  527.         }
  528.     qsort((char *)z0, nn, sizeof(char *), compare);
  529.     for(n = nn, z = z0; n > 0; n--)
  530.         fprintf(f, "%s\n", *z++);
  531.     free((char *)z0);
  532.  done:
  533.     clf(&f, to, 1);
  534.     do {
  535.         mb1 = mb->next;
  536.         free((char *)mb);
  537.         }
  538.         while(mb = mb1);
  539.     return 0;
  540.     }
  541. #endif
  542.